home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / Apfelmonster / Apfelmonster.AMOS / Apfelmonster.amosSourceCode next >
Encoding:
AMOS Source Code  |  1992-11-08  |  6.8 KB  |  246 lines
  1. Set Buffer 20
  2. Close Editor : Close Workbench 
  3. Unpack 6 To 0 : Screen Hide 0
  4. For Y=0 To 11
  5.   For X=0 To 19
  6.     Get Block X+Y*20+1,X*16,Y*16,16,16,0
  7.   Next 
  8. Next 
  9. 'For A=0 To 103
  10. '  Get Sprite A+1,(A mod 20)*16,(A/20)*16+192 To(A mod 20)*16+16,(A/20)*16+208 
  11. 'Next  
  12. Screen Open 1,480,480,32,0
  13. Curs Off : Flash Off : Cls 0 : Get Palette 0
  14. Screen Display 1,128,50,320,192
  15. Screen Close 0
  16. Dim F(29,29,1),AN(23,5),PAT(49,1)
  17. Hide 
  18. LE=1
  19. Gosub LADEN
  20. Gosub ZEIGEN
  21. OX=0 : OY=0 : X=16*AMX : Y=16*AMY : XX=AMX : YY=AMY : LE=1 : A=0
  22. HA=0 : PAT=0
  23. Do 
  24.   If(X mod 16)=0 and(Y mod 16)=0
  25.     RX=(Jleft(1)-Jright(1))*2 : RY=(Jup(1)-Jdown(1))*2
  26.     If RY<0 : DIA=0 : RX=0 : End If 
  27.     If RX>0 : DIA=2 : RY=0 : End If 
  28.     If RY>0 : DIA=4 : RX=0 : End If 
  29.     If RX<0 : DIA=6 : RY=0 : End If 
  30.     F=F(XX+Sgn(RX),YY+Sgn(RY),0)
  31.     If F and 1
  32.       RX=0 : RY=0
  33.     Else 
  34.       PAT(PAT,0)=X/16 : PAT(PAT,1)=Y/16 : Add PAT,1,0 To 49
  35.     End If 
  36.   End If 
  37.   Add DI,Sgn(DIA-DI)
  38.   Add X,RX : Add Y,RY : XX=(X+8)/16 : YY=(Y+8)/16
  39.   If APPS=0 and XX=HMX and YY=HMX Then End 
  40.   If XX<>OLX or YY<>OLY Then OLX=XX : OLY=YY : Gosub NEWBLOCK
  41.   OX=Max(160,Min(320,X))-160 : OY=Max(80,Min(368,Y))-80
  42.   If BL=0 and Rnd(100)=1 Then MX=Rnd(29) : MY=Rnd(29) : If F(MX,MY,1)<8 Then BL=1 : RI=1
  43.   If BL Then Gosub FLAP
  44.   Gosub ANI
  45.   Add HA,1,0 To 7
  46.   If TIM>0 Then Dec TIM : SHI=1-SHI Else SHI=0
  47.   Wait Vbl : Sprite 0,X-OX+128,Y-OY+50,DI+2+SHI*8 : Screen Offset 1,OX,OY
  48.   Sprite 2,HMX*16-OX+128,HMY*16-OY+50,29+HA/2
  49. Loop 
  50. End 
  51. ANI:
  52.   For A=4 To AN
  53.     If AN(A,2)=0 or AN(A,2)=1 Then AN(A,2)=1-AN(A,2)
  54.     If AN(A,2)=3 Then AN(A,2)=2 Else If AN(A,2)=2 Then AN(A,2)=3
  55.     If AN(A,2)>3 Then Add AN(A,2),1,4 To 6
  56.     Bob A+1,AN(A,0),AN(A,1),AN(A,2)+97
  57.   Next 
  58.   For A=0 To 3
  59.     If AN(A,2) Then Gosub BOANI2
  60.   Next 
  61. Return 
  62. BOANI2:
  63.   Gosub COMP
  64.   If(AN(A,0) mod 16)=0 and(AN(A,1) mod 16)=0
  65.     Gosub PATH
  66.   End If 
  67.   Add AN(A,0),RXX : Add AN(A,1),RYY
  68.   Add AN(A,4),Sgn(AN(A,3)-AN(A,4))
  69.   Bob A+1,AN(A,0),AN(A,1),AN(A,2)+25+AN(A,4)
  70. Return 
  71. PATH:
  72.   D=PAT
  73.   For B=0 To 49
  74.     If AN(A,0)/16=PAT(D,0) and AN(A,1)/16=PAT(D,1)
  75.       RXX=PAT(D,0) : RYY=PAT(D,1) : Add D,-1,0 To 49
  76.       RXX=Sgn(PAT(D,0)-RXX)*S : RYY=Sgn(PAT(D,1)-RYY)*S
  77.       Home : Print RXX,RYY
  78.       Exit 
  79.     End If 
  80.     Add D,-1,0 To 49
  81.   Next 
  82.   If B=50 Then Gosub SIMPLE : Return 
  83.   Gosub CONV
  84. Return 
  85. ALGORYTHM:
  86.   RXXA=RXX : RYYA=RYY
  87.   C=0 : D=20000
  88.   Repeat 
  89.     AN(A,3)=Rnd(3)*2
  90.     Gosub COMP
  91.     D2=Abs((AN(A,0)+Sgn(RXX)*16)-X)+Abs((AN(A,1)+Sgn(RYY)*16)-Y)
  92.     F=F(AN(A,0)/16+Sgn(RXX),AN(A,1)/16+Sgn(RYY),0)
  93.     If D>D2 and(F and 1)=0 Then D=D2 : RXXA=RXX : RYYA=RYY Else Inc C
  94.   Until(F and 1)=0 and C>3
  95.   RXX=RXXA : RYY=RYYA : Gosub CONV
  96. Return 
  97. SIMPLE:
  98.   If(F(AN(A,0)/16+Sgn(RXX),AN(A,1)/16+Sgn(RYY),0) and 1) or Rnd(10)=0
  99.     RXXA=-RXX : RYYA=-RYY
  100.     C=0
  101.     Repeat 
  102.       AN(A,3)=Rnd(3)*2
  103.       Gosub COMP
  104.       F=F(AN(A,0)/16+Sgn(RXX),AN(A,1)/16+Sgn(RYY),0)
  105.       Inc C
  106.     Until(F and 1)=0 and((RXX<>RXXA and RYY<>RYYA) or C>9)
  107.   End If 
  108. Return 
  109. COMP:
  110.   B=AN(A,5) and 3 : S=1
  111.   If B=1 Then S=2
  112.   If B=2 Then S=4
  113.   If B=3 Then S=8
  114.   If AN(A,3)=0 Then RYY=-S : RXX=0
  115.   If AN(A,3)=4 Then RYY=S : RXX=0
  116.   If AN(A,3)=6 Then RXX=-S : RYY=0
  117.   If AN(A,3)=2 Then RXX=S : RYY=0
  118. Return 
  119. CONV:
  120.   If RYY<0 Then AN(A,3)=0
  121.   If RXX>0 Then AN(A,3)=2
  122.   If RYY>0 Then AN(A,3)=4
  123.   If RXX<0 Then AN(A,3)=6
  124. Return 
  125. FLAP:
  126.   Put Block 163+BL*7+(F(MX,MY,1)-1) mod 7,MX*16,MY*16
  127.   Add BL,RI
  128.   If BL=7 Then RI=-1
  129.   If BL=0 Then F(MX,MY,1)=(F(MX,MY,1)-1 mod 7)+1+(12+Rnd(8))*7 : Put Block 1+F(MX,MY,1),MX*16,MY*16
  130. Return 
  131. NEWBLOCK:
  132.   F=(F(XX,YY,1)-1)/7 : SH=(F(XX,YY,1)-1) mod 7 : D=0
  133.   If F=1 Then D=1 : Inc SC : Dec APPS
  134.   If F=2 Then F(XX,YY,1)=SH+8 : Put Block SH+9,XX*16,YY*16 : Add SC,2
  135.   If F=13 Then Add F(XX,YY,1),(1+Rnd(8))*7 : Put Block F(XX,YY,1)+1,XX*16,YY*16 : Add SC,50
  136.   If F>13 and F<22 Then D=1 : Add SC,(F-11)*25
  137.   If F=22 Then D=1 : Add TIM,200 : SHI=0
  138.   If D Then F(XX,YY,1)=SH+1 : Put Block SH+2,XX*16,YY*16
  139.   FA=(F(XX,YY,0) and 6) : NR=(F(XX,YY,0) and 248)/8
  140.   If FA=2 Then Gosub TELEPORT : Return 
  141.   If FA=4 Then Gosub SWITCH : Return 
  142.   If FA=6 Then Gosub SECRET
  143. Return 
  144. SECRET:
  145.   Colour 0,$F00
  146. Return 
  147. SWITCH:
  148.   AD=ST+100+NR*20
  149.   For A=0 To 4
  150.     AAX=Peek(AD+A*4) : AAY=Peek(AD+A*4+1)
  151.     If AAX>0 and AAY>0
  152.       AA=F(AAX,AAY,1) : If(AA-1)/7=1 or(AA-1)/7=2 : Dec APPS : End If 
  153.       F(AAX,AAY,0)=Peek(AD+A*4+2)
  154.       F(AAX,AAY,1)=Peek(AD+A*4+3)
  155.       AX=AAX : AY=AAY : Gosub MAKESHADOW
  156.       If F(AAX,AAY,1)>219 or AA>219
  157.         AX=AAX+1 : AY=AAY : Gosub MAKESHADOW
  158.         AX=AAX : AY=AAY+1 : Gosub MAKESHADOW
  159.         AX=AAX+1 : AY=AAY+1 : Gosub MAKESHADOW
  160.       End If 
  161.       AA=(F(AAX,AAY,1)-1)/7 : If AA=1 or AA=2 : Inc APPS : End If 
  162.     End If 
  163.   Next 
  164. Return 
  165. TELEPORT:
  166.   AX=Peek(ST+40+NR*2)*16 : AY=Peek(ST+41+NR*2)*16
  167.   A=0
  168.   Repeat 
  169.     For B=1 To 31
  170.       Colour B,$FFF-Colour(B)
  171.     Next 
  172.     If Abs(AX-X)>9 Then Add X,(AX-X)/10 Else Add X,Sgn(AX-X)
  173.     If Abs(AY-Y)>9 Then Add Y,(AY-Y)/10 Else Add Y,Sgn(AY-Y)
  174.     OX=Max(160,Min(320,X))-160 : OY=Max(80,Min(368,Y))-80
  175.     Wait Vbl : Sprite 0,X-OX+128,Y-OY+50,DI+2 : Screen Offset 1,OX,OY
  176.     Add HA,1,0 To 7
  177.     Sprite 2,HMX*16-OX+128,HMY*16-OY+50,29+HA/2
  178.     Add DI,1,0 To 7
  179.     A=1-A
  180.   Until X=AX and Y=AY
  181.   If A
  182.     For B=1 To 31
  183.       Colour B,$FFF-Colour(B)
  184.     Next 
  185.   End If 
  186. Return 
  187. MAKESHADOW:
  188.   If F(AX,AY,1)>219 Then Put Block F(AX,AY,1)+1,AX*16,AY*16 : Return 
  189.   SH=0
  190.   If AX<1 Then Goto SKIP1
  191.   F=F(AX-1,AY,1) : If F=220 or F=223 or F=225 or F=227 or F=233 Then SH=1
  192.   If F=225 or F=231 or F=232 or F=235 Then SH=5
  193. SKIP1:
  194.   If AY<1 Then Goto SKIP2
  195.   F=F(AX,AY-1,1) : If F=221 or F=223 or F=228 or F=235 Then SH=2
  196.   If F=222 or F=231 or F=233 or F=234 Then SH=6
  197. SKIP2:
  198.   If AX<1 or AY<1 Then Goto SKIP3
  199.   F=F(AX-1,AY-1,1) : If F=224 or F=226 or F=229 or F=230 Then SH=3
  200.   If F=223 or F=231 or F=233 or F=235 Then SH=4
  201. SKIP3:
  202.   F(AX,AY,1)=((F(AX,AY,1)-1)/7)*7+SH+1
  203.   Put Block F(AX,AY,1)+1,AX*16,AY*16
  204. Return 
  205. LADEN:
  206.   Erase 7 : Reserve As Work 7,2200
  207.   Bload "Levels/"+Str$(LE)-" ",Start(7)
  208.   ST=Start(7)
  209.   AMX=Peek(ST) : AMY=Peek(ST+1) : DI=Deek(ST+2)*2 : TIME=Deek(ST+6)
  210.   HMX=Peek(ST+22) : HMY=Peek(ST+23) : APPS=Deek(ST+4)
  211.   SECR=Deek(ST+8)
  212.   NAME$=""
  213.   For A=10 To 21 : NAME$=NAME$+Chr$(Peek(ST+A)) : Next 
  214.   AN=3
  215.   For YY=0 To 29
  216.     For XX=0 To 29
  217.       F(XX,YY,0)=Peek(ST+400+YY*60+XX*2)
  218.       F(XX,YY,1)=Peek(ST+401+YY*60+XX*2)
  219.       If F(XX,YY,1)>71 and F(XX,YY,1)<87
  220.         F=(F(XX,YY,1)-1)/7 : Inc AN
  221.         AN(AN,0)=XX*16 : AN(AN,1)=YY*16
  222.         AN(AN,2)=(F-11)*2
  223.       End If 
  224.     Next 
  225.   Next 
  226.   For A=0 To 3
  227.     AN(A,0)=Peek(ST+24+A*4)*16
  228.     AN(A,1)=Peek(ST+25+A*4)*16
  229.     AN(A,2)=Peek(ST+26+A*4)*8
  230.     AN(A,3)=0
  231.     AN(A,5)=Peek(ST+27+A*4)
  232.   Next 
  233. Return 
  234. ZEIGEN:
  235.   For YY=0 To 29
  236.     For XX=0 To 29
  237.       Put Block F(XX,YY,1)+1,XX*16,YY*16
  238.     Next 
  239.   Next 
  240.   For A=0 To 3
  241.     If AN(A,2) Then Bob A+1,AN(A,0),AN(A,1),AN(A,2)+25
  242.   Next 
  243.   For A=4 To AN
  244.     Bob A+1,AN(A,0),AN(A,1),AN(A,2)+97
  245.   Next 
  246. Return